functor PropertyList (H : HET_CONTAINER) :> PROPERTY_LIST =
struct
  datatype t 
    = T of H.t list ref
    
  fun equals (T h1, T h2) = h1 = h2
  
  fun new () = T (ref [])
  
  fun 'a newProperty () =
      let val {make = makeH,
               pred = predH,
               peek = peekH} = H.new ()
          fun peek (T l) =
              let fun find l =
                      case l
                       of [] => NONE
                        | x :: xs =>
                          (case peekH x
                           of NONE => find xs
                            | r as SOME _ => r)
              in  find (!l)
              end
          fun add (T l, v) = (l := (makeH v) :: (!l))
          fun remove (T l) =
              let fun rem l =
                      case l
                       of [] => raise Fail "no this property\n"
                        | x :: xs => 
                          if predH x
                          then xs
                          else x :: (rem xs)
              in  l := rem (!l)
              end
      in  {peek = peek,
           add = add,
           remove = remove}
      end
  
  fun 'a newPropertyPrint ppx =
      let val {make = makeH,
               pred = predH,
               peek = peekH} = H.new ()
          fun peek (T l) =
              let fun find l =
                      case l
                       of [] => NONE
                        | x :: xs =>
                          (case peekH x
                           of NONE => find xs
                            | r as SOME _ => r)
              in  find (!l)
              end
          fun add (T l, v) = (l := (makeH v) :: (!l))
          fun remove (T l) =
              let fun rem l =
                      case l
                       of [] => raise Fail "no this property\n"
                        | x :: xs => 
                          if predH x
                          then xs
                          else x :: (rem xs)
              in  l := rem (!l)
              end
          fun pp1 l : unit = case peek l
                       of SOME x => ppx x
                        | NONE => raise Fail "no this property\n"
      in  {peek = peek,
           add = add,
           remove = remove,
           pp = pp1}
      end
end

